home *** CD-ROM | disk | FTP | other *** search
/ TOS Silver 2000 / TOS Silver 2000.iso / programm / MM2_DEV / S / MOS / TOSDEBUG.V1 < prev    next >
Encoding:
Modula Implementation  |  1990-05-03  |  9.9 KB  |  381 lines
  1. IMPLEMENTATION MODULE TOSDebug; (* V#053 *)
  2.  
  3. (* Erstellt Mai '87 von Thomas Tempelmann
  4.    
  5.    Ausgabe von VAR-Parametern   jm 16.12.87  *)
  6.  
  7. (*
  8.  *   T O S - V e r s i o n
  9.  *  =======================
  10.  *
  11.  * Gibt Modula-Zeilen aus, die erzeugt werden, wenn im Quelltext die
  12.  * Compiler-Option "(*$D+*)" verwendet wird.
  13.  *
  14.  * Eine "Debug"-Ausgabeanweisung, die der Compiler erzeugt, hat folg. Format:
  15.  *
  16.  *   ... normaler Maschinencode ...
  17.  *   TRAP #5       -  Assembler-Anweisung, löst TRAP-5 Exception aus.
  18.  *   DC.W cmd      -  Kennung, die bestimmt, ob Zeile oder eine Zahl angezeigt
  19.  *                    werden soll (siehe unten, Funktion 'dispLine').
  20.  * [ ASC  '...' ]  -  Modula-Text, falls eine Zeile angezeigt werden soll;
  21.  *                    sonst steht die bestimmte Zahl auf dem Parameterstack.
  22.  *)
  23.  
  24. FROM SYSTEM IMPORT ADR, ADDRESS, WORD, LONGWORD;
  25.  
  26. FROM Excepts IMPORT InstallExc, ExcDesc;
  27.  
  28. FROM PrgCtrl IMPORT TermProcess, CatchProcessTerm, TermCarrier;
  29.  
  30. FROM Strings IMPORT Empty, Length;
  31.  
  32. FROM MOSGlobals IMPORT UserBreak, MemArea;
  33.  
  34. FROM SysTypes IMPORT ExcSet, TRAP5;
  35.  
  36. FROM Terminal IMPORT Read, Write, WriteLn, CondRead, WriteString,
  37.         FlushKbd, ReadString;
  38.  
  39. FROM ModCtrl IMPORT GetModName;
  40.  
  41. IMPORT StrConv;
  42.  
  43. TYPE Mode = (m2Line, asmLine, procEntry, procExit);
  44.  
  45. VAR WaitNext, WaitKey: BOOLEAN;
  46.  
  47.  
  48. PROCEDURE WriteLHex (v:LONGWORD);
  49.   BEGIN
  50.     WriteString (StrConv.LHexToStr (v,9))
  51.   END WriteLHex;
  52.  
  53. PROCEDURE dispRegs (VAR info: ExcDesc);
  54.   BEGIN
  55.     WriteLn;
  56.     WITH info DO
  57.       WriteString ('D0:');  WriteLHex (regD0);
  58.       WriteString (' D1:'); WriteLHex (regD1);
  59.       WriteString (' D2:'); WriteLHex (regD2);
  60.       WriteString (' D3:'); WriteLHex (regD3);
  61.       WriteLn;
  62.       WriteString ('D4:');  WriteLHex (regD4);
  63.       WriteString (' D5:'); WriteLHex (regD5);
  64.       WriteString (' D6:'); WriteLHex (regD6);
  65.       WriteString (' D7:'); WriteLHex (regD7);
  66.       WriteLn;
  67.       WriteString ('A0:');  WriteLHex (regA0);
  68.       WriteString (' A1:'); WriteLHex (regA1);
  69.       WriteString (' A2:'); WriteLHex (regA2);
  70.       WriteString (' A3:'); WriteLHex (regA3);
  71.       WriteLn;
  72.       WriteString ('A4:');  WriteLHex (regA4);
  73.       WriteString (' A5:'); WriteLHex (regA5);
  74.       WriteString (' A6:'); WriteLHex (regA6);
  75.       WriteString (' A7:'); WriteLHex (regUSP);
  76.     END
  77.   END dispRegs;
  78.  
  79.  
  80.  
  81. PROCEDURE dispLine (mode: Mode; VAR info: ExcDesc);
  82.   
  83.   VAR buffered: BOOLEAN; bufCh: CHAR;
  84.   
  85.   PROCEDURE KeyPress():BOOLEAN;
  86.     BEGIN
  87.       CondRead (bufCh,buffered);
  88.       RETURN buffered
  89.     END KeyPress;
  90.   
  91.   PROCEDURE GetKey (VAR ch:CHAR);
  92.     BEGIN
  93.       IF buffered THEN
  94.         buffered:= FALSE;
  95.         ch:= bufCh
  96.       ELSE
  97.         Read (ch)
  98.       END
  99.     END GetKey;
  100.   
  101.   VAR ch:CHAR; s:ARRAY [0..9] OF CHAR; p:CARDINAL; done,ok:BOOLEAN;
  102.       ps: POINTER TO ARRAY [0..160] OF CHAR;
  103.       proc,name: ARRAY [0..39] OF CHAR; rel: LONGCARD;
  104.   
  105.   BEGIN (* dispLine *)
  106.     IF WaitKey THEN
  107.       IF ~Continuous OR KeyPress() THEN
  108.         REPEAT
  109.           GetKey (ch);
  110.           ok:= TRUE;
  111.           CASE CAP (ch) OF
  112.             15C: Continuous:= TRUE|                             (* RETURN *)
  113.             ' ': Continuous:= FALSE|                            (* SPACE *)
  114.             3C : TermProcess (UserBreak)|                       (* CTRL-C *)
  115.             'A': Step:= 0L; Active:= TRUE; Continuous:= FALSE|
  116.             'S': WriteString ('Step? '); ReadString (s); p:=0;
  117.                  Step:= StrConv.StrToLCard (s,p,done);
  118.                  IF done THEN
  119.                    Active:= FALSE; Continuous:= TRUE;
  120.                  END|
  121.             'L': LineAddr:= ~LineAddr; ok:= FALSE|
  122.             'H': Hex:= TRUE; ok:= FALSE|
  123.             'D': Hex:= FALSE; ok:= FALSE|
  124.             'R': dispRegs (info); ok:= FALSE|
  125.           ELSE
  126.             ok:= FALSE
  127.           END
  128.         UNTIL ok
  129.       END
  130.     END;
  131.     
  132.     IF WaitNext THEN FlushKbd; WaitKey:= TRUE; WaitNext:= FALSE END;
  133.     
  134.     IF Active THEN Step:= 0L END;
  135.     
  136.     IF Step # 0L THEN
  137.       DEC (Step);
  138.       IF Step = 0L THEN Active:= TRUE; Continuous:= FALSE END;
  139.     END;
  140.     
  141.     ps:= info.regPC;                    (* PC hinter Zeilentext setzen *)
  142.     INC (info.regPC,Length (ps^)+1);
  143.     IF ODD (info.regPC) THEN INC (info.regPC) END;
  144.     
  145.     IF Active THEN                      (* Zeile anzeigen *)
  146.       WriteLn;
  147.       IF (mode = m2Line) OR (mode = asmLine) THEN
  148.         WriteLn;
  149.         IF LineAddr THEN
  150.           WriteLHex (info.regPC);
  151.           WriteString (': ');
  152.           GetModName (info.regPC,name,rel,proc);
  153.           WriteString (name);
  154.           WriteString (' / ');
  155.           IF ~Empty (proc) THEN
  156.             WriteString (proc)
  157.           ELSE
  158.             WriteString (StrConv.LHexToStr (rel,5))
  159.           END;
  160.           WriteLn;
  161.         END;
  162.         IF ps^[0]=12C (* LF *) THEN INC (ps) END;
  163.         WriteString (ps^);
  164.         WriteLn;
  165.       ELSE
  166.         IF mode = procEntry THEN
  167.           WriteString ('-> Enter ')
  168.         ELSE
  169.           WriteString ('<- Exit  ')
  170.         END;
  171.         WriteString (ps^);
  172.       END;
  173.     END;
  174.   END dispLine;
  175.  
  176. PROCEDURE dispLC (VAR info:ExcDesc; VarPar: BOOLEAN);
  177.   VAR p: POINTER TO LONGCARD;
  178.       q: POINTER TO ADDRESS;
  179.   BEGIN
  180.     IF Active THEN
  181.       IF VarPar THEN
  182.         q:= ADDRESS(info.regA3)-4L;
  183.         p:= q^
  184.       ELSE
  185.         p:= ADDRESS(info.regA3)-4L
  186.       END;
  187.       IF Hex THEN
  188.         WriteString (StrConv.LHexToStr (p^,0));
  189.       ELSE
  190.         WriteString (StrConv.CardToStr (p^,0));
  191.       END;
  192.       WriteString ('    ')
  193.     END
  194.   END dispLC;
  195.  
  196. PROCEDURE dispLI (VAR info:ExcDesc; VarPar: BOOLEAN);
  197.   VAR p: POINTER TO LONGINT;
  198.       q: POINTER TO ADDRESS;
  199.   BEGIN
  200.     IF Active THEN
  201.       IF VarPar THEN
  202.         q:= ADDRESS(info.regA3)-4L;
  203.         p:= q^
  204.       ELSE
  205.         p:= ADDRESS(info.regA3)-4L
  206.       END;
  207.       IF Hex THEN
  208.         WriteString (StrConv.LHexToStr (p^,0));
  209.       ELSE
  210.         WriteString (StrConv.IntToStr (p^,0));
  211.       END;
  212.       WriteString ('    ')
  213.     END
  214.   END dispLI;
  215.  
  216. PROCEDURE dispCard (VAR info:ExcDesc; VarPar: BOOLEAN);
  217.   VAR p: POINTER TO CARDINAL;
  218.       q: POINTER TO ADDRESS;
  219.   BEGIN
  220.     IF Active THEN
  221.       IF VarPar THEN
  222.         q:= ADDRESS(info.regA3)-4L;
  223.         p:= q^
  224.       ELSE
  225.         p:= ADDRESS(info.regA3)-2L
  226.       END;
  227.       IF Hex THEN
  228.         WriteString (StrConv.HexToStr (p^,0));
  229.       ELSE
  230.         WriteString (StrConv.CardToStr (p^,0));
  231.       END;
  232.       WriteString ('    ')
  233.     END
  234.   END dispCard;
  235.  
  236. PROCEDURE dispInt (VAR info:ExcDesc; VarPar: BOOLEAN);
  237.   VAR p: POINTER TO INTEGER;
  238.       q: POINTER TO ADDRESS;
  239.   BEGIN
  240.     IF Active THEN
  241.       IF VarPar THEN
  242.         q:= ADDRESS(info.regA3)-4L;
  243.         p:= q^
  244.       ELSE
  245.         p:= ADDRESS(info.regA3)-2L
  246.       END;
  247.       IF Hex THEN
  248.         WriteString (StrConv.HexToStr (p^,0));
  249.       ELSE
  250.         WriteString (StrConv.IntToStr (p^,0));
  251.       END;
  252.       WriteString ('    ')
  253.     END
  254.   END dispInt;
  255.  
  256. PROCEDURE dispChar (VAR info:ExcDesc; VarPar: BOOLEAN);
  257.   VAR p: POINTER TO CHAR;
  258.       q: POINTER TO ADDRESS;
  259.   BEGIN
  260.     IF Active THEN
  261.       IF VarPar THEN
  262.         q:= ADDRESS(info.regA3)-4L;
  263.         p:= q^
  264.       ELSE
  265.         p:= ADDRESS(info.regA3)-2L
  266.       END;
  267.       IF p^ < ' ' THEN          (* Steuerzeichen als Oktalkonstante anzeigen *)
  268.         WriteString (StrConv.NumToStr (ORD (p^),8,0,' '));
  269.         Write ('C')
  270.       ELSE
  271.         Write (p^)
  272.       END;
  273.       WriteString ('    ')
  274.     END
  275.   END dispChar;
  276.  
  277. PROCEDURE dispReal (VAR info:ExcDesc; VarPar: BOOLEAN);
  278.   VAR p: POINTER TO LONGREAL;
  279.       q: POINTER TO ADDRESS;
  280.   BEGIN
  281.     IF Active THEN
  282.       IF VarPar THEN
  283.         q:= ADDRESS(info.regA3)-4L;
  284.         p:= q^
  285.       ELSE
  286.         p:= ADDRESS(info.regA3)-8L
  287.       END;
  288.       WriteString (StrConv.RealToStr (p^,0,9));
  289.       WriteString ('    ')
  290.     END
  291.   END dispReal;
  292.  
  293. PROCEDURE dispBool (VAR info:ExcDesc; VarPar: BOOLEAN);
  294.   VAR p: POINTER TO BOOLEAN;
  295.       q: POINTER TO ADDRESS;
  296.   BEGIN
  297.     IF Active THEN
  298.       IF VarPar THEN
  299.         q:= ADDRESS(info.regA3)-4L;
  300.         p:= q^
  301.       ELSE
  302.         p:= ADDRESS(info.regA3)-2L
  303.       END;
  304.       IF p^ THEN
  305.         WriteString ('TRUE ')
  306.       ELSE
  307.         WriteString ('FALSE')
  308.       END;
  309.       WriteString ('    ')
  310.     END
  311.   END dispBool;
  312.  
  313.  
  314. PROCEDURE HdlExc ( VAR info: ExcDesc ): BOOLEAN;
  315.   VAR no:CARDINAL;
  316.   BEGIN
  317.     no:= CARDINAL (info.regPC^);
  318.     INC (info.regPC,2);
  319.     CASE no OF
  320.       0 : dispLine (m2Line, info)|
  321.       9 : dispLine (asmLine, info)|
  322.       20: dispLine (procEntry, info)|
  323.       21: dispLine (procExit, info)|
  324.     ELSE
  325.       IF Active THEN
  326.         CASE no OF
  327.            1 : dispLC (info, FALSE)|
  328.            2 : dispLI (info, FALSE)|
  329.            3 : dispChar (info, FALSE)|
  330.            4 : dispBool (info, FALSE)|
  331.            5 : dispReal (info, FALSE)|
  332.            6 : dispCard (info, FALSE)|
  333.            7 : dispInt (info, FALSE)|
  334.           11 : dispLC (info, TRUE)|
  335.           12 : dispLI (info, TRUE)|
  336.           13 : dispChar (info, TRUE)|
  337.           14 : dispBool (info, TRUE)|
  338.           15 : dispReal (info, TRUE)|
  339.           16 : dispCard (info, TRUE)|
  340.           17 : dispInt (info, TRUE)|
  341.         ELSE
  342.           DEC (info.regPC,2);
  343.           RETURN TRUE
  344.         END
  345.       END
  346.     END;
  347.     RETURN FALSE
  348.   END HdlExc;
  349.  
  350.  
  351. VAR stk: ARRAY [1..2000] OF WORD;
  352.     wsp: MemArea;
  353.     hdl: ADDRESS;
  354.     tHdl: TermCarrier;
  355.  
  356. PROCEDURE Terminate;
  357.   VAR ch:CHAR;
  358.   BEGIN
  359.     WriteLn;
  360.     WriteString ('Programmende: Bitte Taste...');
  361.     Read (ch)
  362.   END Terminate;
  363.  
  364. BEGIN
  365.   Active:= TRUE;
  366.   Step:= 0L;
  367.   Continuous:= FALSE;
  368.   Hex := FALSE;
  369.   LineAddr:= FALSE;
  370.   
  371.   (* damit erste Zeile sofort erscheint: *)
  372.   WaitKey:= FALSE;
  373.   WaitNext:= TRUE;
  374.   
  375.   wsp.bottom:= ADR (stk);
  376.   wsp.length:= SIZE (stk);
  377.   InstallExc ( ExcSet{TRAP5}, HdlExc, wsp, hdl );
  378.   IF hdl=NIL THEN HALT END;
  379.   CatchProcessTerm (tHdl,Terminate,wsp);
  380. END TOSDebug.
  381.